Parameters

suffix = ""
data_to_read = "./Data/acc_tpm_nCount_mito_no146_15k_cancercells.rds"

functions

Data

acc = readRDS(file = data_to_read)
(message("reading '" %>% paste0(data_to_read %>% basename()) %>% paste0("'")))
reading 'acc_tpm_nCount_mito_no146_15k_cancercells.rds'
NULL
pathways_scores = fread(file = "./Data/ACC_Canonical_Pathway_Scores.txt",sep = ",") %>% as.matrix(rownames=1) %>% t() %>%  as.data.frame()
hallmark_scores = fread(file = "./Data/ACC_Hallmark_Pathway_Scores.txt",sep = ",") %>% as.matrix(rownames=1) %>% t() %>%  as.data.frame()
ln_list = c("ACC22.LN.P11", "ACC22.P12.LN","ACC7.P13")
ln_plates = FetchData(object = acc,vars = "orig.ident") %>% mutate(
  tumor_type = if_else(condition = orig.ident %in% ln_list
                       ,true = "LN"
                       ,false = "primary"))

ln_plates["orig.ident"] <-NULL
acc= AddMetaData(object = acc,metadata = ln_plates)
pathways_scores = cbind(pathways_scores,hallmark_scores)
pathways_scores = pathways_scores[ , colSums(is.na(pathways_scores))==0] #remove cols with NA
pathways_scores = pathways_scores [rownames(pathways_scores) %in% colnames(acc),] #remove cells not in dataset
pathways_scores =  pathways_scores[order(row.names(pathways_scores)),] #order cells like dataset
# run-dim-reduction on genes:
acc <- FindVariableFeatures(acc, selection.method = "vst", nfeatures = 2000)
acc <- ScaleData(acc)
acc <- RunPCA(acc)
ElbowPlot(acc)

acc <- RunUMAP(acc, dims = 1:5)
pathway_scores_assay <- CreateAssayObject(counts = pathways_scores %>% t()) #create an assay
Warning: Feature names cannot have underscores ('_'), replacing with dashes ('-')
acc[["pathway_scores"]] = pathway_scores_assay
Warning: Keys should be one or more alphanumeric characters followed by an underscore, setting key from pathway_scores_ to pathwayscores_
acc <- RunUMAP(acc, dims = 1:5,reduction ="PCA_pathway_scores",reduction.name = "pathway_scores_umap")

acc umaps

gene expression

DimPlot(acc,group.by = "patient.ident")

pathways scores

DimPlot(acc,reduction = "pathway_scores_umap",group.by = "patient.ident")

UMAP by tumor type

genes

DimPlot(acc,reduction = "umap",group.by = "tumor_type")

pathwyas

DimPlot(acc,reduction = "pathway_scores_umap",group.by = "tumor_type")

All PC’s

for (i in 1:8) {
  cat("### PC",i," \n")
  print(VizDimLoadings(acc, dims = i, reduction = "PCA_pathway_scores"))
  cat(' \n\n')
  plot.new()
  dev.off()
}

PC 1

PC 2

PC 3

PC 4

PC 5

PC 6

PC 7

PC 8

cycling cells clustring

hallmark_name = "HALLMARK_G2M_CHECKPOINT"
genesets  =GSEABase::getGmt("./Data/h.all.v7.0.symbols.pluscc.gmt")
var_features=acc@assays$RNA@var.features
geneIds= genesets[[hallmark_name]]@geneIds
score <- apply(acc@assays$RNA@data[intersect(geneIds,var_features),],2,mean)
acc=AddMetaData(acc,score,hallmark_name)

genes

FeaturePlot(acc, reduction = "umap",features = "HALLMARK_G2M_CHECKPOINT")

pathwyas

FeaturePlot(acc, reduction = "pathway_scores_umap",features = "HALLMARK_G2M_CHECKPOINT")

UMAP clusters

acc <- FindNeighbors(acc, dims = 1:10,reduction = "PCA_pathway_scores")
acc <- FindClusters(acc, resolution = 0.1,graph.name = "pathway_scores_snn")
DimPlot(acc,reduction = "pathway_scores_umap")

DEG

markers = FindMarkers(object = acc,ident.1 = "0",ident.2 = "1",assay = "pathway_scores",min.cells.feature = 10,logfc.threshold = 0)
markers

Top 10 pathways

DefaultAssay(acc )= "pathway_scores"
for (i in 1:10) {
  pathway = rownames(markers)[i]
  cat("### ",i," \n")
  print(
    FeaturePlot(object = acc,features = pathway,reduction = "pathway_scores_umap")
    )
  plot.new()
  dev.off()
  cat(' \n\n')
}

1

2

3

4

5

6

7

8

9

10

NA

HEAD-AND-NECK-SQUAMOUS

FeaturePlot(object = acc,features = "WP-HEAD-AND-NECK-SQUAMOUS-CELL-CARCINOMA",reduction = "pathway_scores_umap")

gs=acc@assays$RNA@var.features

myoscore=apply(acc@assays$RNA@scale.data[intersect(c("TP63","TP73","CAV1","CDH3","KRT5","KRT14","ACTA2","TAGLN","MYLK","DKK3"),gs),],2,mean)

lescore=apply(acc@assays$RNA@scale.data[intersect(c("KIT","EHF","ELF5","KRT7","CLDN3","CLDN4","CD24","LGALS3","LCN2","SLPI"),gs),],2,mean)
acc=AddMetaData(acc,lescore-myoscore,"luminal_over_myo")
#set lum_or_myo metadata
luminal_over_myo = FetchData(object = acc,vars = "luminal_over_myo")
luminal_over_myo$lum_or_myo  = case_when(luminal_over_myo$luminal_over_myo >1~"lum",luminal_over_myo$luminal_over_myo <(-1)~"myo",TRUE~"NA")
luminal_over_myo$luminal_over_myo <-NULL
acc=AddMetaData(object = acc,metadata = luminal_over_myo,col.name = "lum_or_myo")
FeaturePlot(object = acc,features = "luminal_over_myo",reduction = "pathway_scores_umap")

DimPlot(acc,group.by = "lum_or_myo",cols = c("red","green","grey"))

LS0tCnRpdGxlOiAnYHIgcnN0dWRpb2FwaTo6Z2V0U291cmNlRWRpdG9yQ29udGV4dCgpJHBhdGggJT4lIGJhc2VuYW1lKCkgJT4lIGdzdWIocGF0dGVybiA9ICJcXC5SbWQiLHJlcGxhY2VtZW50ID0gIiIpYCcgCmF1dGhvcjogIkF2aXNoYWkgV2l6ZWwiCmRhdGU6ICdgciBTeXMuRGF0ZSgpYCcKb3V0cHV0OiAKICBodG1sX25vdGVib29rOiAKICAgIGNvZGVfZm9sZGluZzogaGlkZQogICAgdG9jOiB5ZXMKICAgIHRvY19jb2xsYXBzZTogeWVzCiAgICB0b2NfZmxvYXQ6IAogICAgICBjb2xsYXBzZWQ6IEZBTFNFCi0tLQoKIyMgUGFyYW1ldGVycwoKYGBge3Igd2FybmluZz1GQUxTRX0Kc3VmZml4ID0gIiIKZGF0YV90b19yZWFkID0gIi4vRGF0YS9hY2NfdHBtX25Db3VudF9taXRvX25vMTQ2XzE1a19jYW5jZXJjZWxscy5yZHMiCmBgYAoKCiMjIGZ1bmN0aW9ucwoKYGBge3Igd2FybmluZz1GQUxTRX0KYGBgCgojIyBEYXRhCgpgYGB7cn0KYWNjID0gcmVhZFJEUyhmaWxlID0gZGF0YV90b19yZWFkKQoobWVzc2FnZSgicmVhZGluZyAnIiAlPiUgcGFzdGUwKGRhdGFfdG9fcmVhZCAlPiUgYmFzZW5hbWUoKSkgJT4lIHBhc3RlMCgiJyIpKSkKcGF0aHdheXNfc2NvcmVzID0gZnJlYWQoZmlsZSA9ICIuL0RhdGEvQUNDX0Nhbm9uaWNhbF9QYXRod2F5X1Njb3Jlcy50eHQiLHNlcCA9ICIsIikgJT4lIGFzLm1hdHJpeChyb3duYW1lcz0xKSAlPiUgdCgpICU+JSAgYXMuZGF0YS5mcmFtZSgpCmhhbGxtYXJrX3Njb3JlcyA9IGZyZWFkKGZpbGUgPSAiLi9EYXRhL0FDQ19IYWxsbWFya19QYXRod2F5X1Njb3Jlcy50eHQiLHNlcCA9ICIsIikgJT4lIGFzLm1hdHJpeChyb3duYW1lcz0xKSAlPiUgdCgpICU+JSAgYXMuZGF0YS5mcmFtZSgpCmBgYAoKYGBge3J9CmxuX2xpc3QgPSBjKCJBQ0MyMi5MTi5QMTEiLCAiQUNDMjIuUDEyLkxOIiwiQUNDNy5QMTMiKQpsbl9wbGF0ZXMgPSBGZXRjaERhdGEob2JqZWN0ID0gYWNjLHZhcnMgPSAib3JpZy5pZGVudCIpICU+JSBtdXRhdGUoCiAgdHVtb3JfdHlwZSA9IGlmX2Vsc2UoY29uZGl0aW9uID0gb3JpZy5pZGVudCAlaW4lIGxuX2xpc3QKICAgICAgICAgICAgICAgICAgICAgICAsdHJ1ZSA9ICJMTiIKICAgICAgICAgICAgICAgICAgICAgICAsZmFsc2UgPSAicHJpbWFyeSIpKQoKbG5fcGxhdGVzWyJvcmlnLmlkZW50Il0gPC1OVUxMCmFjYz0gQWRkTWV0YURhdGEob2JqZWN0ID0gYWNjLG1ldGFkYXRhID0gbG5fcGxhdGVzKQpgYGAKCgpgYGB7cn0KcGF0aHdheXNfc2NvcmVzID0gY2JpbmQocGF0aHdheXNfc2NvcmVzLGhhbGxtYXJrX3Njb3JlcykKcGF0aHdheXNfc2NvcmVzID0gcGF0aHdheXNfc2NvcmVzWyAsIGNvbFN1bXMoaXMubmEocGF0aHdheXNfc2NvcmVzKSk9PTBdICNyZW1vdmUgY29scyB3aXRoIE5BCnBhdGh3YXlzX3Njb3JlcyA9IHBhdGh3YXlzX3Njb3JlcyBbcm93bmFtZXMocGF0aHdheXNfc2NvcmVzKSAlaW4lIGNvbG5hbWVzKGFjYyksXSAjcmVtb3ZlIGNlbGxzIG5vdCBpbiBkYXRhc2V0CnBhdGh3YXlzX3Njb3JlcyA9ICBwYXRod2F5c19zY29yZXNbb3JkZXIocm93Lm5hbWVzKHBhdGh3YXlzX3Njb3JlcykpLF0gI29yZGVyIGNlbGxzIGxpa2UgZGF0YXNldApgYGAKCmBgYHtyIHdhcm5pbmc9RkFMU0UsIHJlc3VsdHM9J2hpZGUnLGVjaG89VFJVRX0KIyBydW4tZGltLXJlZHVjdGlvbiBvbiBnZW5lczoKYWNjIDwtIEZpbmRWYXJpYWJsZUZlYXR1cmVzKGFjYywgc2VsZWN0aW9uLm1ldGhvZCA9ICJ2c3QiLCBuZmVhdHVyZXMgPSAyMDAwKQphY2MgPC0gU2NhbGVEYXRhKGFjYykKYWNjIDwtIFJ1blBDQShhY2MpCkVsYm93UGxvdChhY2MpCmBgYAoKCmBgYHtyfQphY2MgPC0gUnVuVU1BUChhY2MsIGRpbXMgPSAxOjUpCmBgYAoKCgpgYGB7cn0KcGF0aHdheV9zY29yZXNfYXNzYXkgPC0gQ3JlYXRlQXNzYXlPYmplY3QoY291bnRzID0gcGF0aHdheXNfc2NvcmVzICU+JSB0KCkpICNjcmVhdGUgYW4gYXNzYXkKYWNjW1sicGF0aHdheV9zY29yZXMiXV0gPSBwYXRod2F5X3Njb3Jlc19hc3NheQpgYGAKYGBge3Igd2FybmluZz1GQUxTRSwgcmVzdWx0cz0naGlkZScsZWNobz1UUlVFfQojIHJ1bi1kaW0tcmVkdWN0aW9uOgphY2MgPC0gRmluZFZhcmlhYmxlRmVhdHVyZXMoYWNjLCBzZWxlY3Rpb24ubWV0aG9kID0gInZzdCIsIG5mZWF0dXJlcyA9IDIwMDAsYXNzYXkgPSAicGF0aHdheV9zY29yZXMiKQphY2MgPC0gU2NhbGVEYXRhKGFjYyxhc3NheSA9ICJwYXRod2F5X3Njb3JlcyIsZmVhdHVyZXMgPSByb3duYW1lcyhhY2NbWyJwYXRod2F5X3Njb3JlcyJdXSkpCmFjYyA8LSBSdW5QQ0EoYWNjLCBmZWF0dXJlcyA9IHJvd25hbWVzKGFjY1tbInBhdGh3YXlfc2NvcmVzIl1dKSxhc3NheSA9ICJwYXRod2F5X3Njb3JlcyIscmVkdWN0aW9uLm5hbWUgPSAiUENBX3BhdGh3YXlfc2NvcmVzIikKRWxib3dQbG90KGFjYyxyZWR1Y3Rpb24gPSAgIlBDQV9wYXRod2F5X3Njb3JlcyIpCmBgYAoKCmBgYHtyfQphY2MgPC0gUnVuVU1BUChhY2MsIGRpbXMgPSAxOjUscmVkdWN0aW9uID0iUENBX3BhdGh3YXlfc2NvcmVzIixyZWR1Y3Rpb24ubmFtZSA9ICJwYXRod2F5X3Njb3Jlc191bWFwIikKYGBgCiMjIGFjYyB1bWFwcyB7LnRhYnNldH0KCiMjIyBnZW5lIGV4cHJlc3Npb24KCgpgYGB7cn0KRGltUGxvdChhY2MsZ3JvdXAuYnkgPSAicGF0aWVudC5pZGVudCIpCmBgYAojIyMgcGF0aHdheXMgc2NvcmVzCgpgYGB7cn0KRGltUGxvdChhY2MscmVkdWN0aW9uID0gInBhdGh3YXlfc2NvcmVzX3VtYXAiLGdyb3VwLmJ5ID0gInBhdGllbnQuaWRlbnQiKQpgYGAKIyMgVU1BUCBieSB0dW1vciB0eXBlIHsudGFic2V0fQoKIyMjIGdlbmVzCmBgYHtyfQpEaW1QbG90KGFjYyxyZWR1Y3Rpb24gPSAidW1hcCIsZ3JvdXAuYnkgPSAidHVtb3JfdHlwZSIpCgpgYGAKCiMjIyBwYXRod3lhcwoKYGBge3J9CkRpbVBsb3QoYWNjLHJlZHVjdGlvbiA9ICJwYXRod2F5X3Njb3Jlc191bWFwIixncm91cC5ieSA9ICJ0dW1vcl90eXBlIikKYGBgCgojIyBBbGwgUEMncyB7LnRhYnNldH0KCmBgYHtyIGVjaG89VFJVRSwgZmlnLmhlaWdodD04LCBmaWcud2lkdGg9MTQsIHJlc3VsdHM9J2FzaXMnfQpmb3IgKGkgaW4gMTo4KSB7CiAgY2F0KCIjIyMgUEMiLGksIiBcbiIpCiAgcHJpbnQoVml6RGltTG9hZGluZ3MoYWNjLCBkaW1zID0gaSwgcmVkdWN0aW9uID0gIlBDQV9wYXRod2F5X3Njb3JlcyIpKQogIGNhdCgnIFxuXG4nKQogIHBsb3QubmV3KCkKICBkZXYub2ZmKCkKfQpgYGAKCgojIyBjeWNsaW5nIGNlbGxzIGNsdXN0cmluZyB7LnRhYnNldH0KYGBge3Igd2FybmluZz1GQUxTRX0KaGFsbG1hcmtfbmFtZSA9ICJIQUxMTUFSS19HMk1fQ0hFQ0tQT0lOVCIKZ2VuZXNldHMgID1HU0VBQmFzZTo6Z2V0R210KCIuL0RhdGEvaC5hbGwudjcuMC5zeW1ib2xzLnBsdXNjYy5nbXQiKQp2YXJfZmVhdHVyZXM9YWNjQGFzc2F5cyRSTkFAdmFyLmZlYXR1cmVzCmdlbmVJZHM9IGdlbmVzZXRzW1toYWxsbWFya19uYW1lXV1AZ2VuZUlkcwpzY29yZSA8LSBhcHBseShhY2NAYXNzYXlzJFJOQUBkYXRhW2ludGVyc2VjdChnZW5lSWRzLHZhcl9mZWF0dXJlcyksXSwyLG1lYW4pCmFjYz1BZGRNZXRhRGF0YShhY2Msc2NvcmUsaGFsbG1hcmtfbmFtZSkKYGBgCgoKIyMjIGdlbmVzCmBgYHtyfQpGZWF0dXJlUGxvdChhY2MsIHJlZHVjdGlvbiA9ICJ1bWFwIixmZWF0dXJlcyA9ICJIQUxMTUFSS19HMk1fQ0hFQ0tQT0lOVCIpCmBgYAoKIyMjIHBhdGh3eWFzCgpgYGB7cn0KRmVhdHVyZVBsb3QoYWNjLCByZWR1Y3Rpb24gPSAicGF0aHdheV9zY29yZXNfdW1hcCIsZmVhdHVyZXMgPSAiSEFMTE1BUktfRzJNX0NIRUNLUE9JTlQiKQpgYGAKIyMgVU1BUCBjbHVzdGVycwpgYGB7cn0KYWNjIDwtIEZpbmROZWlnaGJvcnMoYWNjLCBkaW1zID0gMToxMCxyZWR1Y3Rpb24gPSAiUENBX3BhdGh3YXlfc2NvcmVzIikKYWNjIDwtIEZpbmRDbHVzdGVycyhhY2MsIHJlc29sdXRpb24gPSAwLjEsZ3JhcGgubmFtZSA9ICJwYXRod2F5X3Njb3Jlc19zbm4iKQpgYGAKCmBgYHtyfQpEaW1QbG90KGFjYyxyZWR1Y3Rpb24gPSAicGF0aHdheV9zY29yZXNfdW1hcCIpCmBgYAojIyBERUcKYGBge3J9Cm1hcmtlcnMgPSBGaW5kTWFya2VycyhvYmplY3QgPSBhY2MsaWRlbnQuMSA9ICIwIixpZGVudC4yID0gIjEiLGFzc2F5ID0gInBhdGh3YXlfc2NvcmVzIixtaW4uY2VsbHMuZmVhdHVyZSA9IDEwLGxvZ2ZjLnRocmVzaG9sZCA9IDApCmBgYAo8ZGl2IHN0eWxlPSd3aWR0aDoxMzAwcHg7bWFyZ2luOiAwIGF1dG87Jz4KCmBgYHtyIGVjaG89VFJVRX0KbWFya2VycwpgYGAKPC9kaXY+CgojIyBUb3AgMTAgcGF0aHdheXMgey50YWJzZXR9CgoKYGBge3IgZWNobz1UUlVFLCByZXN1bHRzPSdhc2lzJ30KRGVmYXVsdEFzc2F5KGFjYyApPSAicGF0aHdheV9zY29yZXMiCmZvciAoaSBpbiAxOjEwKSB7CiAgcGF0aHdheSA9IHJvd25hbWVzKG1hcmtlcnMpW2ldCiAgY2F0KCIjIyMgIixpLCIgXG4iKQogIHByaW50KAogICAgRmVhdHVyZVBsb3Qob2JqZWN0ID0gYWNjLGZlYXR1cmVzID0gcGF0aHdheSxyZWR1Y3Rpb24gPSAicGF0aHdheV9zY29yZXNfdW1hcCIpCiAgICApCiAgcGxvdC5uZXcoKQogIGRldi5vZmYoKQogIGNhdCgnIFxuXG4nKQp9CmBgYAoKIyMgSEVBRC1BTkQtTkVDSy1TUVVBTU9VUwpgYGB7ciB3YXJuaW5nPUZBTFNFfQpGZWF0dXJlUGxvdChvYmplY3QgPSBhY2MsZmVhdHVyZXMgPSAiV1AtSEVBRC1BTkQtTkVDSy1TUVVBTU9VUy1DRUxMLUNBUkNJTk9NQSIscmVkdWN0aW9uID0gInBhdGh3YXlfc2NvcmVzX3VtYXAiKQpgYGAKCgoKCmBgYHtyfQpncz1hY2NAYXNzYXlzJFJOQUB2YXIuZmVhdHVyZXMKCm15b3Njb3JlPWFwcGx5KGFjY0Bhc3NheXMkUk5BQHNjYWxlLmRhdGFbaW50ZXJzZWN0KGMoIlRQNjMiLCJUUDczIiwiQ0FWMSIsIkNESDMiLCJLUlQ1IiwiS1JUMTQiLCJBQ1RBMiIsIlRBR0xOIiwiTVlMSyIsIkRLSzMiKSxncyksXSwyLG1lYW4pCgpsZXNjb3JlPWFwcGx5KGFjY0Bhc3NheXMkUk5BQHNjYWxlLmRhdGFbaW50ZXJzZWN0KGMoIktJVCIsIkVIRiIsIkVMRjUiLCJLUlQ3IiwiQ0xETjMiLCJDTERONCIsIkNEMjQiLCJMR0FMUzMiLCJMQ04yIiwiU0xQSSIpLGdzKSxdLDIsbWVhbikKYWNjPUFkZE1ldGFEYXRhKGFjYyxsZXNjb3JlLW15b3Njb3JlLCJsdW1pbmFsX292ZXJfbXlvIikKYGBgCgpgYGB7cn0KI3NldCBsdW1fb3JfbXlvIG1ldGFkYXRhCmx1bWluYWxfb3Zlcl9teW8gPSBGZXRjaERhdGEob2JqZWN0ID0gYWNjLHZhcnMgPSAibHVtaW5hbF9vdmVyX215byIpCmx1bWluYWxfb3Zlcl9teW8kbHVtX29yX215byAgPSBjYXNlX3doZW4obHVtaW5hbF9vdmVyX215byRsdW1pbmFsX292ZXJfbXlvID4xfiJsdW0iLGx1bWluYWxfb3Zlcl9teW8kbHVtaW5hbF9vdmVyX215byA8KC0xKX4ibXlvIixUUlVFfiJOQSIpCmx1bWluYWxfb3Zlcl9teW8kbHVtaW5hbF9vdmVyX215byA8LU5VTEwKYWNjPUFkZE1ldGFEYXRhKG9iamVjdCA9IGFjYyxtZXRhZGF0YSA9IGx1bWluYWxfb3Zlcl9teW8sY29sLm5hbWUgPSAibHVtX29yX215byIpCmBgYAoKYGBge3Igd2FybmluZz1GQUxTRX0KRmVhdHVyZVBsb3Qob2JqZWN0ID0gYWNjLGZlYXR1cmVzID0gImx1bWluYWxfb3Zlcl9teW8iLHJlZHVjdGlvbiA9ICJwYXRod2F5X3Njb3Jlc191bWFwIikKRGltUGxvdChhY2MsZ3JvdXAuYnkgPSAibHVtX29yX215byIsY29scyA9IGMoInJlZCIsImdyZWVuIiwiZ3JleSIpKQpgYGA=